class: title-slide # ER018 - Analyzing Business Relations & Documents ## PVA3 ### Soziale Netzwerkanalyse <br> <br> <br> <br> <br> <br> <br> ### FS 2024 <br> ### Prof. Dr. Jörg Schoder .mycontacts[
@FFHS-EconomicResearch
@jfschoder ] --- layout: true <div class="my-footer"></div> <div style="position: absolute;left:400px;bottom:10px;font-size:9px">
Prof. Dr. Jörg Schoder</div> --- name: agenda class: left .blockquote[Agenda] ## Einführung in die Netzwerkanalayse * Netzwerkdaten erzeugen und importieren * Netzwerkdaten visualisieren * Vermessung von Netzwerken --- class: inverse, center, middle ## Netzwerkdaten erzeugen und importieren .blockquote[Elementare Netzwerkdaten] .blockquote[Netzwerkobjekte erzeugen] .blockquote[Netzwerkdaten importieren] .blockquote[Netzwerkdaten transformieren] --- class: left .blockquote[Elementare Netzwerkdaten] ## Akteure, Beziehungen und Eigenschaften * Knoten (mit Eigenschaften): ```r library(tidyverse) #most popular babynames in CH 2022 actors <- tibble(name=c("Emma","Mia","Sofia","Noah","Liam","Matteo"), sex=c("weiblich","weiblich","weiblich","männlich","männlich","männlich")) ``` * Kanten (mit Eigenschaften): ```r ties <- tibble(from=c("Noah","Noah","Noah","Noah","Noah"), to=c("Emma","Mia","Sofia","Liam","Matteo"), type=c("Partnerin","Kollegin","Kollegin","Freund","Freund"), interaction=c(7,2,3,5,2)) ``` --- class: left .blockquote[Knoten und Kanten] ## Aufgabe: Erzeuge Knoten und Kanten zum dargestellten Graphen: <!-- --> --- class: left .blockquote[Netzwerkobjekte erzeugen] ## Netzwerkobjekte mit igraph und tidygraph * igraph-Objekt erzeugen ```r library(igraph) # Paket laden ig <- graph_from_data_frame(ties, directed=FALSE, vertices=actors) class(ig) ``` ``` ## [1] "igraph" ``` * `tbl_graph()`-Objekt erzeugen ```r library(tidygraph) # Paket laden tg <- tbl_graph(nodes = actors, edges = ties, directed = FALSE) ``` --- class: left .blockquote[Netzwerkdaten importieren] ## Beispiel: Daten "Hochzeitsmarkt Florenz" * Daten im **network**-Paket enthalten ```r library(network) # ggf. Paket installieren data(flo) net_flo <- graph_from_adjacency_matrix(flo) tidy_flo <- as_tbl_graph(net_flo) ``` --- class: left .blockquote[Netzwerkdaten importieren] ## Beispiel: Datensatz "Media"-Example importieren * Knoten importieren ```r my_in_file <- "Dataset1-Media-Example-NODES.csv" nodes <- readr::read_csv(xfun::from_root("data","raw","PVA2",my_in_file)) ``` -- * Aufgabe: Kanten importieren: * Download-Links für die Datensätze: * [Knoten](https://github.com/FFHS-EconomicResearch/ER018/blob/main/data/raw/PVA2/Dataset1-Media-Example-NODES.csv) * [Kanten](https://github.com/FFHS-EconomicResearch/ER018/blob/main/data/raw/PVA2/Dataset1-Media-Example-EDGES.csv) --- class: left .blockquote[Netzwerkdaten transformieren] ## Beispiel: Florentinische Familien .panelset[ .panel[.panel-name[Transformation] * Nützliche **tidygraph**-Funktionen * `activate()` * `.E()`, `.N()` * Beispiel: Hinzufügen der Eigenschaft "direkter Zugang zu den Medici" ```r flo_tidy <- tidy_flo %>% activate("edges") %>% # Kanten aktivieren mutate(to_medici=(.N()$name[from]=="Medici" | .N()$name[to]=="Medici")) ``` ] .panel[.panel-name[Vorher] ```r tidy_flo ``` ``` ## # A tbl_graph: 16 nodes and 40 edges ## # ## # A directed simple graph with 2 components ## # ## # A tibble: 16 × 1 ## name ## <chr> ## 1 Acciaiuoli ## 2 Albizzi ## 3 Barbadori ## 4 Bischeri ## 5 Castellani ## 6 Ginori ## # ℹ 10 more rows ## # ## # A tibble: 40 × 2 ## from to ## <int> <int> ## 1 1 9 ## 2 2 6 ## 3 2 7 ## # ℹ 37 more rows ``` ] .panel[.panel-name[Vorher] ```r flo_tidy ``` ``` ## # A tbl_graph: 16 nodes and 40 edges ## # ## # A directed simple graph with 2 components ## # ## # A tibble: 40 × 3 ## from to to_medici ## <int> <int> <lgl> ## 1 1 9 TRUE ## 2 2 6 FALSE ## 3 2 7 FALSE ## 4 2 9 TRUE ## 5 3 5 FALSE ## 6 3 9 TRUE ## # ℹ 34 more rows ## # ## # A tibble: 16 × 1 ## name ## <chr> ## 1 Acciaiuoli ## 2 Albizzi ## 3 Barbadori ## # ℹ 13 more rows ``` ] ] --- class: left .blockquote[Netzwerkdaten transformieren] ## Teilgruppen (Subgraph) extrahieren ```r medici_sub <- flo_tidy %>% activate("edges") %>% filter(to_medici) ``` --- class: inverse, center, middle ## Netzwerkdaten visualisieren .blockquote[Einfache plots mit igraph] .blockquote[Flexible plots mit ggraph] ??? * ToDo Interaktive Plots mit visNetwork --- class: left .blockquote[Plots mit igraph] ## Vom Netzwerkobjekt zum Graphen ```r plot(ig) ``` <img src="data:image/png;base64,#02_tidyNA_files/figure-html/unnamed-chunk-13-1.png" width="40%" style="display: block; margin: auto;" /> --- class: left .blockquote[Flexible Plots mit ggraph] ## Vom Netzwerkobjekt zum Graphen ```r library(ggraph) tg %>% ggraph(layout = "graphopt") + geom_node_point(size=7,color=FFHSred) + geom_node_text(aes(label = name,color=FFHSpurp), vjust=1.55,hjust=1.2,show.legend = FALSE) + geom_edge_link(color=FFHSpurp,width=1.1, start_cap = ggraph::circle(3,'mm'), end_cap = ggraph::circle(3,'mm')) + theme_void() ``` <img src="data:image/png;base64,#02_tidyNA_files/figure-html/unnamed-chunk-14-1.png" width="35%" style="display: block; margin: auto;" /> --- class: left .blockquote[Flexible Plots mit ggraph] ## Aufgabe: Medici-Netzwerk .content-box-purple[ .white[ Erzeuge einen Graphen zum Medici-Netzwerk. Die Kanten von Familien mit "direktem Zugang" zu den Medici sollen dabei hervorgehoben werden.] ] <!-- --> ??? geom_edge_link0(aes(edge_color = to_medici))+ --- class: inverse, center, middle ## Vermessung von Netzwerken .blockquote[Zentralität] .blockquote[Dichte] .blockquote[Pfade und Distanzen] .blockquote[Verbundenheit] .blockquote[Clustering] ??? Gliederung nach Barabasi (2016) --- class: .blockquote[Zentralität] ## Beispiel: Freundschaftsnetzwerk * `activate()` ```r tg %>% activate(nodes) %>% mutate(degree = centrality_degree()) ``` ``` ## # A tbl_graph: 6 nodes and 5 edges ## # ## # An unrooted tree ## # ## # A tibble: 6 × 3 ## name sex degree ## <chr> <chr> <dbl> ## 1 Emma weiblich 1 ## 2 Mia weiblich 1 ## 3 Sofia weiblich 1 ## 4 Noah männlich 5 ## 5 Liam männlich 1 ## 6 Matteo männlich 1 ## # ## # A tibble: 5 × 4 ## from to type interaction ## <int> <int> <chr> <dbl> ## 1 1 4 Partnerin 7 ## 2 2 4 Kollegin 2 ## 3 3 4 Kollegin 3 ## # ℹ 2 more rows ``` ```r tg %>% activate(edges) %>% mutate(betweenness = centrality_edge_betweenness(), # .N() gets the nodes data from edge you're accessing homo = (.N()$sex[from] == .N()$sex[to])) ``` ``` ## # A tbl_graph: 6 nodes and 5 edges ## # ## # An unrooted tree ## # ## # A tibble: 5 × 6 ## from to type interaction betweenness homo ## <int> <int> <chr> <dbl> <dbl> <lgl> ## 1 1 4 Partnerin 7 5 FALSE ## 2 2 4 Kollegin 2 5 FALSE ## 3 3 4 Kollegin 3 5 FALSE ## 4 4 5 Freund 5 5 TRUE ## 5 4 6 Freund 2 5 TRUE ## # ## # A tibble: 6 × 2 ## name sex ## <chr> <chr> ## 1 Emma weiblich ## 2 Mia weiblich ## 3 Sofia weiblich ## # ℹ 3 more rows ``` --- class: left .blockquote[Zentralität] ## Beispiel: Florentinische Familien .content-box-purple[ .white[ Ermittle zwei Zentralitätsmaße für das florentinische Familiennetzwerk.] ] ``` ## # A tbl_graph: 16 nodes and 40 edges ## # ## # A directed simple graph with 2 components ## # ## # A tibble: 16 × 3 ## name degree betweenness ## <chr> <dbl> <dbl> ## 1 Acciaiuoli 1 0 ## 2 Albizzi 3 38.7 ## 3 Barbadori 2 17 ## 4 Bischeri 3 19 ## 5 Castellani 3 10 ## 6 Ginori 1 0 ## # ℹ 10 more rows ## # ## # A tibble: 40 × 3 ## from to to_medici ## <int> <int> <lgl> ## 1 1 9 TRUE ## 2 2 6 FALSE ## 3 2 7 FALSE ## # ℹ 37 more rows ``` --- class: left .blockquote[Zentralität] ## Grafische Darstellung der Zentralität am Beispiel "Medici" <!-- --> --- class: left .blockquote[Pfade und Distanzen] ## Durchmesser ```r tg %>% mutate(Diameter = graph_diameter()) ``` ``` ## # A tbl_graph: 6 nodes and 5 edges ## # ## # An unrooted tree ## # ## # A tibble: 6 × 3 ## name sex Diameter ## <chr> <chr> <dbl> ## 1 Emma weiblich 2 ## 2 Mia weiblich 2 ## 3 Sofia weiblich 2 ## 4 Noah männlich 2 ## 5 Liam männlich 2 ## 6 Matteo männlich 2 ## # ## # A tibble: 5 × 4 ## from to type interaction ## <int> <int> <chr> <dbl> ## 1 1 4 Partnerin 7 ## 2 2 4 Kollegin 2 ## 3 3 4 Kollegin 3 ## # ℹ 2 more rows ``` --- class: left .blockquote[Clustering] ## Beispiel mit Zufallsdaten ```r # create random graph with group structure (igraph equivalent is sample_islands()) play_islands(4, 12, 0.8, 4) %>% mutate(community = as.factor(group_louvain())) %>% activate("edges") %>% mutate(community = as.factor(ifelse(.N()$community[from]==.N()$community[to],.N()$community[from],5))) %>% ggraph(layout = 'stress') + geom_edge_link0(aes(edge_colour=community),show.legend = FALSE) + geom_node_point(aes(fill = community), shape = 21, size = 6) + scale_fill_brewer(palette = "Set3")+ scale_edge_color_brewer(palette = "Set3")+ theme_graph(background = "grey88") ``` <!-- --> ??? * Fokus auf einer Entität bzw. einem Knoten ("Ego") --- class: inverse,center,middle # Wir brauchen eine Pause. --- background-image: url("data:image/png;base64,#http://bit.ly/cs631-donkey") background-size: 80% --- class: left ## Quellenverzeichnis .ref-slide[ ``` ## You haven't cited any references in this bibliography yet. ``` NULL ]